﻿namespace FML

#light

module ReaderT =
 module List = 
 
  open ReaderM
  open ListM
  
  type IReaderListTrans = interface
    abstract Bind : Reader<'a list, 'env> * ('a -> Reader<'b list, 'env>) -> Reader<'b list, 'env>
    abstract Let :  'a * ('a ->  Reader<'b list, 'env>) -> Reader<'b list, 'env>
    abstract Return : 'a -> Reader<'a list, 'env>
    abstract Delay : f:(unit -> Reader<'a list, 'env>) -> Reader<'a list, 'env>
    abstract Lift : a:'a list -> Reader<'a list, 'env>  
  end
  
  type ReaderListBuilder(listM : IListMonad) = class end
    with interface IReaderListTrans with
                member s.Bind(m, f) =  ReaderT ( fun env -> listM { let! a = Reader<_, _>.RunM m env
                                                                   return!  Reader<_, _>.RunM (f a) env
                                                                 })
                member s.Let(a, f) =   f a
                member s.Return a = ReaderT (fun _ -> listM.Return(a))
                member s.Delay f = f()
                member s.Lift(m) = ReaderT (fun _ -> m)


  let readerListT = new ReaderListBuilder(listM) :>  IReaderListTrans
 
 module Option = 

  open ReaderM
  open OptionM
  
  type IReaderOptionTrans = interface
    abstract Bind : Reader<'a option, 'env> * ('a -> Reader<'b option, 'env>) -> Reader<'b option, 'env>
    abstract Let :  'a * ('a ->  Reader<'b option, 'env>) -> Reader<'b option, 'env>
    abstract Return : 'a -> Reader<'a option, 'env>
    abstract Delay : f:(unit -> Reader<'a option, 'env>) -> Reader<'a option, 'env>
    abstract Lift : a:'a option -> Reader<'a option, 'env>  
  end
  
  type ReaderOptionBuilder(optionM : IOptionMonad) = class end
    with interface IReaderOptionTrans with
                member s.Bind(m, f) =  ReaderT ( fun env -> optionM { let! a =  Reader<_, _>.RunM m env
                                                                     return!  Reader<_, _>.RunM (f a) env
                                                                   })
                member s.Let(a, f) =   f a
                member s.Return a = ReaderT (fun _ -> optionM.Return(a))
                member s.Delay f = f()
                member s.Lift(m) = ReaderT (fun _ -> m)


  let readerOptionT = new ReaderOptionBuilder(optionM) :>  IReaderOptionTrans
 
 module Error = 

  open ReaderM
  open ErrorM
  
  type IReaderErrorTrans = interface
    abstract Bind : Reader<Either<'l, 'a>, 'env> * ('a -> Reader<Either<'l, 'b>, 'env>) ->  Reader<Either<'l, 'b>, 'env>
    abstract Let :  'a * ('a -> Reader<Either<'l, 'b>, 'env>) ->  Reader<Either<'l, 'b>, 'env>
    abstract Return : 'a -> Reader<Either<'l, 'a>, 'env>
    abstract Delay : f:(unit -> Reader<Either<'l, 'a>, 'env>) -> Reader<Either<'l, 'a>, 'env>
  end
  
  let lift m =  ReaderT (fun _ -> m)
  let throwError e = (lift << ErrorM.throwError) e
  let catch m handler = ReaderT (fun env -> ErrorM.catch (Reader<_, _>.RunM m env) (fun e -> Reader<_, _>.RunM (handler e) env))

  type ReaderErrorBuilder(errorM : IErrorMonad) = class end
    with interface IReaderErrorTrans with
                member s.Bind(m, f) =  ReaderT ( fun env -> errorM  { let! a =  Reader<_, _>.RunM m env
                                                                     return!  Reader<_, _>.RunM (f a) env
                                                                   })
                member s.Let(a, f) =   f a
                member s.Return a = ReaderT (fun _ -> errorM.Return(a))
                member s.Delay f = f()


  let readerErrorT = new ReaderErrorBuilder(errorM) :>  IReaderErrorTrans
 
 module Writer = 

  open ReaderM
  open WriterM
  open Monoid
  
  type IReaderWriterTrans<'s> = interface
    abstract Bind : Reader<Writer<'a, 's>, 'env> * ('a -> Reader<Writer<'b, 's>, 'env>) ->  Reader<Writer<'b, 's>, 'env>
    abstract Let :  'a * ('a -> Reader<Writer<'b, 's>, 'env>) ->  Reader<Writer<'b, 's>, 'env>
    abstract Return : 'a -> Reader<Writer<'a, 's>, 'env>
    abstract Delay : f:(unit -> Reader<Writer<'a, 's>, 'env>) -> Reader<Writer<'a, 's>, 'env>
    abstract Lift : a:Writer<'a, 's> ->Reader<Writer<'a, 's>, 'env>
    abstract Tell :  's -> Reader<Writer<unit,'s>,'a>
//    abstract Listen : Reader<WriterM.Writer<'a,'b>,'c> -> Reader<WriterM.Writer<('a * 'b),'b>,'c>
//    abstract Pass : Reader<WriterM.Writer<('a * ('b -> 'c)),'b>,'d> -> Reader<WriterM.Writer<'a,'c>,'d>
  end
  
  
  //let listen(rwT:IReaderWriterTrans<'s>) m = Reader (fun env -> writerM.Listen (ReaderM.run m env))

  //let pass(rwT:IReaderWriterTrans<'s>) m = Reader (fun env -> writerM.Pass (ReaderM.run m env))


  type ReaderWriterBuilder<'s>(writerM : IWriterMonad<'s>) = class end
    with interface IReaderWriterTrans<'s> with
                member s.Bind(m, f) =  ReaderT ( fun env -> writerM { let! a = Reader<_, _>.RunM m env
                                                                     return! Reader<_, _>.RunM (f a) env
                                                                   })
                member s.Let(a, f) =   f a
                member s.Return a = ReaderT (fun _ -> writerM.Return(a))
                member s.Delay f = f()
                member s.Lift(m) = ReaderT (fun _ -> m)
                member s.Tell(a) =  let lift m = (s:>IReaderWriterTrans<'s>).Lift(m)
                                    (lift << writerM.Tell) a


  let readerWriterT (monoid : Monoid<'s>) = new ReaderWriterBuilder<'s>(writerM monoid) :>  IReaderWriterTrans<'s>
  
  
 module State = 

  open ReaderM
  open StateM
  
  type IReaderStateTrans = interface
    abstract Bind : Reader<State<'a, 's>, 'env> * ('a -> Reader<State<'b, 's>, 'env>) ->  Reader<State<'b, 's>, 'env>
    abstract Let :  'a * ('a -> Reader<State<'b, 's>, 'env>) ->  Reader<State<'b, 's>, 'env>
    abstract Return : 'a -> Reader<State<'a, 's>, 'env>
    abstract Delay : f:(unit -> Reader<State<'a, 's>, 'env>) -> Reader<State<'a, 's>, 'env>
  end
  
  type ReaderStateBuilder(stateM : IStateMonad) = class end
    with interface IReaderStateTrans with
                member s.Bind(m, f) =  ReaderT ( fun env -> stateM  { let! a =  Reader<_, _>.RunM m env
                                                                     return!  Reader<_, _>.RunM (f a) env
                                                                   })
                member s.Let(a, f) =   f a
                member s.Return a = ReaderT (fun _ -> stateM.Return(a))
                member s.Delay f = f()


  let readerStateT = new ReaderStateBuilder(stateM) :>  IReaderStateTrans
 
  let lift m = ReaderT (fun _ -> m)

  let get() = lift StateM.get

  let set newState = lift (StateM.set newState)

  let modify f = lift (StateM.modify f)